home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE08 / FILES / NAMES3U2.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-03-07  |  3.9 KB  |  147 lines
  1. unit Names3u2;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils;
  7.  
  8. type
  9.   TDataRec = packed record
  10.     { The form's edit box has its MaxLength property set to 30 }
  11.     Name: String[30];
  12.     { Only interested in the date portion of this date/time value }
  13.     DOB: TDateTime;
  14.   end;
  15.  
  16.   TDataFile = class
  17.   private
  18.     FDataFile: Integer;
  19.   protected
  20.     function GetCount: Longint;
  21.     function GetCurrent: Longint;
  22.     function GetRecord(Index: Longint): TDataRec;
  23.     procedure SetCurrent(RecNo: Longint);
  24.     procedure SetRecord(Index: Longint; const DataRec: TDataRec);
  25.   public
  26.     constructor Create;
  27.     destructor Destroy; override;
  28.     property Count: Longint read GetCount;
  29.     property Current: Longint
  30.       read GetCurrent write SetCurrent;
  31.     property Records[Index: Longint]: TDataRec
  32.       read GetRecord write SetRecord; default;
  33.   end;
  34.  
  35. implementation
  36.  
  37. uses
  38.   WinProcs, Forms, NetLock, Consts, Classes;
  39.  
  40. const
  41.   FileName = 'DataFile.Dat';
  42.  
  43. {$ifndef Win32}
  44. function GetFileSize(Handle: Integer): Longint;
  45. var
  46.   OldPos, FileSize: Longint;
  47. begin
  48.   Result := FileSeek(Handle, 0, soFromCurrent);
  49.   if Result > -1 then
  50.   begin
  51.     OldPos := Result;
  52.     FileSize := FileSeek(Handle, 0, soFromEnd);
  53.     if FileSize > -1 then
  54.     begin
  55.       Result := FileSeek(Handle, OldPos, soFromBeginning);
  56.       if Result > -1 then
  57.         Result := FileSize;
  58.     end;
  59.   end;
  60. end;
  61. {$endif}
  62.  
  63. constructor TDataFile.Create;
  64. begin
  65.   { Make current directory where EXE file is, just in case }
  66.   ChDir(ExtractFilePath(Application.ExeName));
  67.   { Make file if it ain't there }
  68.   if not FileExists(FileName) then
  69.     FDataFile := FileCreate(FileName);
  70.   if FDataFile < 0 then
  71.     raise EFCreateError.Create(FmtLoadStr(SFCreateError, [FileName]));
  72.   { Close handle returned by FileCreate so we can open it in shared mode }
  73.   FileClose(FDataFile);
  74.   FDataFile := FileOpen(FileName, fmOpenReadWrite or fmShareDenyNone);
  75.   if FDataFile < 0 then
  76.     raise EFOpenError.Create(FmtLoadStr(SFOpenError, [FileName]));
  77. end;
  78.  
  79. destructor TDataFile.Destroy;
  80. begin
  81.   FileClose(FDataFile);
  82.   inherited Destroy;
  83. end;
  84.  
  85. function TDataFile.GetCount: Longint;
  86. begin
  87. {$ifndef Win32}
  88.   Result := GetFileSize(FDataFile) div SizeOf(TDataRec);
  89. {$else}
  90.   Result := GetFileSize(FDataFile, nil) div SizeOf(TDataRec);
  91. {$endif}
  92. end;
  93.  
  94. function TDataFile.GetCurrent: Longint;
  95. begin
  96.   Result := FileSeek(FDataFile, 0, soFromCurrent);
  97.   if Result > -1 then
  98.     Result := Result div SizeOf(TDataRec);
  99. end;
  100.  
  101. function TDataFile.GetRecord(Index: Longint): TDataRec;
  102. begin
  103.   Current := Index;
  104.   if FileRead(FDataFile, Result, SizeOf(TDataRec)) < SizeOf(TDataRec) then
  105.     raise EListError.CreateRes(SListIndexError);
  106.   { Go back to the beginning of the read record }
  107.   Current := Index;
  108. end;
  109.  
  110. procedure TDataFile.SetCurrent(RecNo: Longint);
  111. begin
  112.   { Anything past EOF is considered EOF }
  113.   if RecNo > Count then
  114.     RecNo := Count;
  115.   FileSeek(FDataFile, RecNo * SizeOf(TDataRec), soFromBeginning);
  116. end;
  117.  
  118. procedure TDataFile.SetRecord(Index: Longint; const DataRec: TDataRec);
  119. var
  120.   X: EInOutError;
  121. begin
  122.   Current := Index;
  123.   if not LockFileArea(FDataFile, Current * SizeOf(TDataRec),
  124.     SizeOf(TDataRec), False) then
  125.   begin
  126.     X := EInOutError.Create('Cannot lock file');
  127.     { Set up a file access denied type exception }
  128.     X.ErrorCode := 5;
  129.     raise X;
  130.   end;
  131.   try
  132.     { DataRec is passed as a const (pass by reference, but }
  133.     { not allowed to be treated/passed as a var parameter). }
  134.     { We can get around this by dereferencing its }
  135.     { address with an appropriate typecast }
  136.     if FileWrite(FDataFile, DataRec, SizeOf(TDataRec)) < SizeOf(TDataRec) then
  137.       raise EInOutError.Create('Cannot write to file');
  138.     { Go back to the beginning of the written record }
  139.     Current := Index;
  140.   finally
  141.     LockFileArea(FDataFile, Current * SizeOf(TDataRec),
  142.       SizeOf(TDataRec), True);
  143.   end;
  144. end;
  145.  
  146. end.
  147.